home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmfix.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-08  |  13.2 KB  |  385 lines
  1. PROGRAM bbmfix;
  2.  
  3. (*===========================================================================*)
  4. (* Fix message file                                                          *)
  5. (*                                                                           *)
  6. (*   Copyright 1988 by H. Roy Engehausen.  All rights reserved.              *)
  7. (*   This software may be freely distributed and used, but it may not        *)
  8. (*   under any circumstances be sold by anyone other than the author.        *)
  9. (*   It may be distributed by a commercial company as long as it is          *)
  10. (*   for no cost.                                                            *)
  11. (*                                                                           *)
  12. (*   Permission is explicity granted to use this code as a model for         *)
  13. (*   other programs as long as they carry this copyright notice and the      *)
  14. (*   imbedded copyright constants                                            *)
  15. (*                                                                           *)
  16. (*===========================================================================*)
  17.  
  18. {$R+}    {Range checking on}
  19. {$B-}    {Boolean complete evaluation off}
  20. {$S+}    {Stack checking on}
  21. {$I+}    {I/O checking on}
  22. {$V+}    {String var checks}
  23. {$N-}    {No numeric coprocessor}
  24.  
  25. USES
  26.   CRT,
  27.   bbdummy;
  28.  
  29. (*===========================================================================*)
  30. (* Main program begins here                                                  *)
  31. (*===========================================================================*)
  32.  
  33. VAR
  34.   dis_p           : msg_d_ptr;
  35.   e_file          : FILE OF msg_block;
  36.   first_time      : BOOLEAN;
  37.   fix_file        : FILE OF msg_block;
  38.   i               : WORD;
  39.   i_name          : STRING;
  40.   li              : LONGINT;
  41.   k               : WORD;
  42.   msg_buffer      : msg_block;
  43.   msg_file        : FILE OF msg_block;
  44.   msg2_buffer     : msg_block;
  45.   next_msg_no     : WORD;
  46.   no_blk          : WORD;
  47.   no_blk_max      : WORD;
  48.   no_blk_tell     : WORD;
  49.   o_name          : STRING;
  50.   rename_it       : BOOLEAN;
  51.   x_switch        : BOOLEAN;
  52.  
  53. LABEL
  54.   loop;
  55.  
  56. FUNCTION yn : BOOLEAN;
  57.   VAR
  58.     c : CHAR;
  59.     x : STRING;
  60.  
  61.   BEGIN;
  62.  
  63.     IF x_switch THEN
  64.       BEGIN;
  65.         yn := TRUE;
  66.         EXIT;
  67.       END;
  68.  
  69.     WHILE TRUE DO
  70.       BEGIN;
  71.         WRITELN('Enter Y or N or X (Yes and dont ask anymore)');
  72.         READLN(x);
  73.         IF LENGTH(x) <> 1 THEN
  74.           WRITELN('Wrong length')
  75.         ELSE
  76.           BEGIN;
  77.             c := UPCASE(x[1]);
  78.             IF c = 'X' THEN
  79.               BEGIN;
  80.                 x_switch := TRUE;
  81.                 yn := TRUE;
  82.                 EXIT;
  83.               END;
  84.             IF (c = 'Y') OR (c = 'N') THEN
  85.               BEGIN;
  86.                 yn := c = 'Y';
  87.                 EXIT;
  88.               END;
  89.             WRITELN('Answer not Y or N');
  90.           END;
  91.  
  92.       END;
  93.   END;
  94.  
  95. FUNCTION deleteme : BOOLEAN;
  96.   BEGIN;
  97.     WRITELN('Delete this record?');
  98.     deleteme := yn;
  99.   END;
  100.  
  101. (*===========================================================================*)
  102. (* Main program begins here                                                  *)
  103. (*===========================================================================*)
  104.  
  105.   BEGIN;
  106.  
  107.     dis_p := @msg2_buffer;
  108.  
  109.     x_switch := FALSE;
  110.  
  111.     i_name  := PARAMSTR(1);
  112.     o_name  := PARAMSTR(2);
  113.  
  114.     IF i_name = '' THEN
  115.       i_name := 'MSG.BB';
  116.  
  117.     IF o_name = '' THEN
  118.       BEGIN;
  119.         o_name := 'MSG.OK';
  120.         rename_it := TRUE;
  121.       END
  122.     ELSE
  123.       rename_it := FALSE;
  124.  
  125.     (*-----------------------------------------------------------------------*)
  126.     (* Open msg file for read                                                *)
  127.     (*-----------------------------------------------------------------------*)
  128.  
  129.     ASSIGN(msg_file, i_name);
  130.     {$I-}
  131.     RESET(msg_file);
  132.     {$I+}
  133.     i := IORESULT;
  134.  
  135.     (*-----------------------------------------------------------------------*)
  136.     (* Check for open OK                                                     *)
  137.     (*-----------------------------------------------------------------------*)
  138.  
  139.     IF (i <> 0) AND (i <> 2) THEN
  140.       BEGIN;
  141.         WRITELN('Unable to open ', opt_block.msg_file_name);
  142.         WRITELN('DOS Error # ', i);
  143.       END;
  144.  
  145.     (*-----------------------------------------------------------------------*)
  146.     (* File doesn't exist.                                                   *)
  147.     (*-----------------------------------------------------------------------*)
  148.  
  149.     IF i <> 0 THEN
  150.       BEGIN;
  151.  
  152.         WRITELN('File does not exist');
  153.         HALT;
  154.  
  155.       END;
  156.  
  157.     (*-----------------------------------------------------------------------*)
  158.     (* Open msg file for write                                               *)
  159.     (*-----------------------------------------------------------------------*)
  160.  
  161.     ASSIGN(fix_file, o_name);
  162.     REWRITE(fix_file);
  163.  
  164.     (*-----------------------------------------------------------------------*)
  165.     (* Check the version of the file                                         *)
  166.     (*-----------------------------------------------------------------------*)
  167.  
  168.     READ(msg_file, msg_buffer);
  169.     i := msg_buffer.msg_number;
  170.     IF i <> sys_version THEN
  171.       BEGIN;
  172.         WRITELN('Wanted version ', sys_version, ' msg file');
  173.         WRITELN('Got version ', i, ' msg file');
  174.         HALT;
  175.       END;
  176.  
  177.     (*-----------------------------------------------------------------------*)
  178.     (* Write the version header                                              *)
  179.     (*-----------------------------------------------------------------------*)
  180.  
  181.     WRITE(fix_file, msg_buffer);
  182.  
  183.     (*-----------------------------------------------------------------------*)
  184.     (* Read in the message file                                              *)
  185.     (*-----------------------------------------------------------------------*)
  186.  
  187.     next_msg_no := 1;
  188.     first_time  := TRUE;
  189.  
  190.     no_blk      := 0;
  191.     no_blk_tell := 0;
  192.     no_blk_max  := FILESIZE(msg_file) - 1;
  193.  
  194. loop:
  195.     WHILE no_blk < no_blk_max DO
  196.       BEGIN;
  197.  
  198.         li := SIZEOF(msg_buffer);
  199.         li := li * no_blk;
  200.  
  201.         i := no_blk DIV 10;
  202.         IF i <> no_blk_tell THEN
  203.           BEGIN;
  204.             no_blk_tell := i;
  205.             WRITELN('Processing record # ', no_blk);
  206.           END;
  207.  
  208.         (*-------------------------------------------------------------------*)
  209.         (* Read in the next record                                           *)
  210.         (*-------------------------------------------------------------------*)
  211.  
  212.         INC(no_blk);
  213.  
  214.         READ(msg_file, msg_buffer);
  215.  
  216.         (*-------------------------------------------------------------------*)
  217.         (* Validate number                                                   *)
  218.         (*-------------------------------------------------------------------*)
  219.  
  220.         IF first_time THEN
  221.           BEGIN;
  222.             WITH msg_buffer DO
  223.               next_msg_no := msg_number - 1;
  224.             first_time := FALSE;
  225.           END;
  226.  
  227.         WITH msg_buffer DO
  228.           IF next_msg_no > msg_number THEN
  229.             BEGIN;
  230.               WRITELN('**** Warning -- MSG file out of sequence');
  231.               WRITELN('Record number # ', no_blk, '(', li,
  232.                                                     ') is msg # ', msg_number);
  233.               WRITELN('High   number # ', next_msg_no);
  234.               IF deleteme THEN GOTO loop;
  235.             END
  236.           ELSE
  237.             BEGIN;
  238.               IF (next_msg_no + 100) < msg_number THEN
  239.                 BEGIN;
  240.                   WRITELN('**** Warning -- MSG file gap detected');
  241.                   WRITELN('Record number # ', no_blk, '(', li,
  242.                                                      ') is msg # ', msg_number);
  243.                   WRITELN('High   number # ', next_msg_no);
  244.                   IF deleteme THEN GOTO loop;
  245.                 END;
  246.  
  247.               next_msg_no := msg_number + 1;
  248.  
  249.             END;
  250.  
  251.         (*-------------------------------------------------------------------*)
  252.         (* Validate sizes                                                    *)
  253.         (*-------------------------------------------------------------------*)
  254.  
  255.         WITH msg_buffer DO
  256.           BEGIN;
  257.  
  258.             IF LENGTH(msg_to) >= SIZEOF(msg_to) THEN
  259.               BEGIN;
  260.                 WRITELN('**** Warning -- MSG_TO size error');
  261.                 WRITELN('Record number # ', no_blk, '(', li,
  262.                                                       ') is msg # ', msg_number);
  263.                 WRITELN('MSG_TO = ', msg_to);
  264.                 WRITELN('L = ', LENGTH(msg_to), ' -- MAX = ', SIZEOF(msg_to));
  265.                 IF deleteme THEN GOTO loop;
  266.               END;
  267.  
  268.             IF LENGTH(msg_to_at) >= SIZEOF(msg_to_at) THEN
  269.               BEGIN;
  270.                 WRITELN('**** Warning -- MSG_TO_AT size error');
  271.                 WRITELN('Record number # ', no_blk, '(', li,
  272.                                                      ') is msg # ', msg_number);
  273.                 WRITELN('MSG_TO_AT = ', msg_to_at);
  274.                 WRITELN('L = ', LENGTH(msg_to_at),
  275.                                                ' -- MAX = ', SIZEOF(msg_to_at));
  276.                 IF deleteme THEN GOTO loop;
  277.               END;
  278.  
  279.             IF LENGTH(msg_from) >= SIZEOF(msg_from) THEN
  280.               BEGIN;
  281.                 WRITELN('**** Warning -- MSG_FROM size error');
  282.                 WRITELN('Record number # ', no_blk, '(', li,
  283.                                                      ') is msg # ', msg_number);
  284.                 WRITELN('MSG_FROM = ', msg_from);
  285.                 WRITELN('L = ', LENGTH(msg_from),
  286.                                                 ' -- MAX = ', SIZEOF(msg_from));
  287.                 IF deleteme THEN GOTO loop;
  288.               END;
  289.  
  290.             IF LENGTH(msg_from_at) >= SIZEOF(msg_from_at) THEN
  291.               BEGIN;
  292.                 WRITELN('**** Warning -- MSG_FROM_AT size error');
  293.                 WRITELN('Record number # ', no_blk, '(', li,
  294.                                                      ') is msg # ', msg_number);
  295.                 WRITELN('MSG_FROM = ', msg_from_at);
  296.                 WRITELN('L = ', LENGTH(msg_from_at),
  297.                                              ' -- MAX = ', SIZEOF(msg_from_at));
  298.                 IF deleteme THEN GOTO loop;
  299.               END;
  300.  
  301.             IF LENGTH(msg_bid) >= SIZEOF(msg_bid) THEN
  302.               BEGIN;
  303.                 WRITELN('**** Warning -- MSG_BID size error');
  304.                 WRITELN('Record number # ', no_blk, '(', li,
  305.                                                      ') is msg # ', msg_number);
  306.                 WRITELN('MSG_BID = ', msg_bid);
  307.                 WRITELN('L = ', LENGTH(msg_bid),
  308.                                                ' -- MAX = ', SIZEOF(msg_bid));
  309.                 IF deleteme THEN GOTO loop;
  310.               END;
  311.  
  312.             IF LENGTH(msg_subj) >= SIZEOF(msg_subj) THEN
  313.               BEGIN;
  314.                 WRITELN('**** Warning -- MSG_SUBJ size error');
  315.                 WRITELN('Record number # ', no_blk, '(', li,
  316.                                                      ') is msg # ', msg_number);
  317.                 WRITELN('MSG_SUBJ = ', msg_subj);
  318.                 WRITELN('L = ', LENGTH(msg_subj),
  319.                                                ' -- MAX = ', SIZEOF(msg_subj));
  320.                 IF deleteme THEN GOTO loop;
  321.               END;
  322.  
  323.           END;
  324.  
  325.         (*-------------------------------------------------------------------*)
  326.         (* Read in distribution list                                         *)
  327.         (*-------------------------------------------------------------------*)
  328.  
  329.         IF (mf_fwd_list AND msg_buffer.msg_flag) <> 0 THEN
  330.           BEGIN;
  331.  
  332.             INC(no_blk);
  333.  
  334.             READ(msg_file, msg2_buffer);
  335.  
  336.             WITH dis_p^ DO
  337.               BEGIN;
  338.  
  339.                 IF msg_d_no > msg_dist_max THEN
  340.                   BEGIN;
  341.                     WRITELN('Invalid distribution # -- ', msg_d_no);
  342.                     WRITELN('M # = ', msg_buffer.msg_number);
  343.                     WRITELN('I = ', i);
  344.                     IF deleteme THEN GOTO loop;
  345.                   END;
  346.  
  347.               END;
  348.  
  349.           END;
  350.  
  351.         (*-------------------------------------------------------------------*)
  352.         (* Write fix file                                                    *)
  353.         (*-------------------------------------------------------------------*)
  354.  
  355.         WRITE(fix_file, msg_buffer);
  356.         IF (mf_fwd_list AND msg_buffer.msg_flag) <> 0 THEN
  357.           WRITE(fix_file, msg2_buffer);
  358.  
  359.       END; (*----- End of loop reading records ------------------------------*)
  360.  
  361.     WRITELN('Processed ', no_blk, ' records.');
  362.  
  363.     CLOSE(msg_file);
  364.  
  365.     CLOSE(fix_file);
  366.  
  367.     IF rename_it THEN
  368.       BEGIN;
  369.  
  370.         ASSIGN(e_file, 'MSG.BAD');
  371.         {$I-}
  372.         ERASE(e_file);
  373.         i := IORESULT;
  374.         {$I+}
  375.  
  376.         RENAME(msg_file, 'MSG.BAD');
  377.         RENAME(fix_file, 'MSG.BB');
  378.  
  379.         WRITELN('The good file is still MSG.BB');
  380.         WRITELN('The bad file has been renamed MSG.BAD');
  381.  
  382.       END;
  383.  
  384.   END.
  385.